home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / fileread.zip / FILEREAD.PAS < prev    next >
Pascal/Delphi Source File  |  1992-04-16  |  8KB  |  311 lines

  1.  
  2. {*************************************************************************
  3.  *                    LOW LEVEL FILE READING OBJECT                      *
  4.  *                                                                       *
  5.  *                      Copyright 1992 Tom Clancy                        *
  6.  *                                                                       *
  7.  *   Description:                                                        *
  8.  *                                                                       *
  9.  *        This library allows you to create a file of any type record    *
  10.  *   by passing in the record size.  You must also pass in a record of   *
  11.  *   the same type that the object has been initialized with so that     *
  12.  *   you don't get errors when reading and writing.                      *
  13.  *                                                                       *
  14.  *        There is no internal buffering, but the routines are fairly    *
  15.  *   fast and because each file is actually an object, you can create    *
  16.  *   higher level objects of this object type that allow more            *
  17.  *   flexibility, such as indexing and sorting.                          *
  18.  *                                                                       *
  19.  *************************************************************************}
  20.  
  21. {$I-}   {Turn off I/O checking}
  22. {$S-}   {Turn off Stack checking}
  23. {$R-}   {Turn off Range checking}
  24. {$V-}   {No strict VAR string checking allowed here!}
  25.  
  26. Unit FileRead;
  27.  
  28. Interface
  29.  
  30. Const
  31.  
  32.    Open       = 1;
  33.    Create     = 2;
  34.    OpenCreate = 3;
  35.  
  36. Type
  37.  
  38.    TFreadPtr = ^TFreadObj;
  39.    TFreadObj = Object
  40.      Constructor Init(fn : string; mode:integer; recsize : longint);
  41.      Destructor  Done;
  42.  
  43.      { random access methods. }
  44.      Procedure   ReadRec(var frec; fpos:longint);  virtual;
  45.      Procedure   WriteRec(var frec; fpos:longint); virtual;
  46.  
  47.      { sequential access methods. }
  48.      Procedure   AppendRec(var frec);
  49.      Procedure   ReadNext(var frec);
  50.      Procedure   ReadPrevious(var frec);
  51.      Procedure   ReadCurrent(var frec);
  52.  
  53.      { various file modification methods. }
  54.      Procedure   EraseFile;
  55.      Function    RenameFile(fn:string):boolean;
  56.  
  57.      { miscellaneous functions and error flag functions. }
  58.      Procedure   Rewind;
  59.      Function    NumRecs     : Longint;
  60.      Function    GetFilename : String;
  61.      Function    GetCurrent  : Longint;
  62.      Function    OpenError   : boolean;
  63.      Function    ReadError   : boolean;
  64.      Function    WriteError  : boolean;
  65.  
  66.    private
  67.      Ifile       : File;     {file variable}
  68.      Rsize       : Longint;  {the internal record size}
  69.      FileName    : String;   {physical file name}
  70.      Oerror,                 {open error flag}
  71.      Rerror,                 {read error flag}
  72.      Werror      : Boolean;  {write error flag}
  73.      Current     : Longint;  {current file pointer location}
  74.  
  75.      { methods used internally.  No access allowed! }
  76.      Procedure   OpenFile;
  77.      Procedure   CreateFile;
  78.      Procedure   CloseFile;
  79.    end;
  80.  
  81. Function Exist(fn:string):Boolean;
  82.  
  83. Implementation
  84.  
  85. uses
  86.   Dos;
  87.  
  88. { Pass in a string which contains a file name to see if that file exists.}
  89. Function Exist(fn:string):Boolean;
  90. Var
  91.    DirInfo : SearchRec;
  92. Begin
  93.   FindFirst(fn,Archive,DirInfo);
  94.   Exist:=DosError=0;
  95. End;
  96.  
  97. {
  98.     Initialize the object.
  99.  
  100.     Fn    = File name
  101.     Mode  = Open, Create, or OpenCreate
  102.       - Open will try to open the file.  An error is set if the file does not
  103.         exist.
  104.       - Create will create the file regardless if it's there or not.
  105.       - OpenCreate will attemp to open the file first, then create it if it's
  106.         not there.
  107.     RecSize = The size of the records that the file will contain.
  108.       - Use Sizeof(Rec) for safety.
  109. }
  110. Constructor TFreadObj.Init(fn:string; mode:integer; recsize:longint);
  111. Begin
  112.   Oerror:=true;
  113.   Rerror:=false;
  114.   Werror:=false;
  115.   Rsize:=recsize;
  116.   FileName := fn;
  117.   Assign(Ifile,FileName);
  118.   case mode of
  119.     Open       : openfile;
  120.     Create     : createfile;
  121.     OpenCreate :
  122.       begin
  123.         OpenFile;
  124.         if Oerror then
  125.           CreateFile;
  126.       end;
  127.   end;
  128. End;
  129.  
  130. { Close the file when disposing object. }
  131. Destructor TFreadObj.done;
  132. begin
  133.   CloseFile;
  134. end;
  135.  
  136. { Open the file.  Set an error if it could not open. }
  137. Procedure TFreadObj.OpenFile;
  138. Begin
  139.   if Exist(FileName) then
  140.   begin
  141.     Oerror:=false;
  142.     Reset(Ifile,Rsize);
  143.     Current:=0;
  144.   end
  145.   else
  146.     Oerror:=true;
  147. End;
  148.  
  149. { Create a new file, zeroing out an existing file.}
  150. Procedure TFreadObj.CreateFile;
  151. Begin
  152.   Rewrite(Ifile,Rsize);
  153.   Current:=0;
  154.   Oerror:=Ioresult<>0;
  155. end;
  156.  
  157. { Close the file only if it has been successfully opened.}
  158. Procedure TFreadObj.CloseFile;
  159. Begin
  160.   if not Oerror then
  161.   begin
  162.     Close(Ifile);
  163.     Oerror:=true;
  164.   end;
  165. End;
  166.  
  167. { Will erase the file.}
  168. Procedure TFreadObj.EraseFile;
  169. Begin
  170.   if not Oerror then
  171.   begin
  172.     CloseFile;
  173.     Erase(Ifile);
  174.   end;
  175. End;
  176.  
  177. { Renames the file.}
  178. Function TFreadObj.RenameFile(fn:string):Boolean;
  179. Var
  180.   Temp : Longint; {Save the current file pointer}
  181. Begin
  182.   CloseFile;
  183.   FileName:=fn;
  184.   Rename(Ifile,FileName);
  185.   if ioresult=0 then
  186.   begin
  187.     Temp:=Current;
  188.     Assign(Ifile,FileName);
  189.     OpenFile;
  190.     Current:=Temp;
  191.   end;
  192.   RenameFile := not Oerror;
  193. end;
  194.  
  195. { Rewinds the file pointer back to the beginning.}
  196. Procedure TFreadObj.Rewind;
  197. Begin
  198.   if not Oerror then
  199.   begin
  200.     Seek(Ifile,0);
  201.     Current:=0;
  202.   end;
  203. end;
  204.  
  205.  
  206. Function TFreadObj.OpenError:Boolean;
  207. Begin
  208.   OpenError:=Oerror;
  209. End;
  210.  
  211. Function TFreadObj.ReadError:Boolean;
  212. Begin
  213.   ReadError:=Rerror;
  214. End;
  215.  
  216. Function TFreadObj.WriteError:Boolean;
  217. Begin
  218.   WriteError:=Werror;
  219. End;
  220.  
  221. { Reads a record from the file at location FPOS.  Returns the record in
  222.   Frec.}
  223. Procedure TFreadObj.ReadRec(var frec; fpos:longint);
  224. Var
  225.   numread : word;
  226. Begin
  227.   Rerror:=false;
  228.   if not Oerror then
  229.   begin
  230.     Seek(Ifile,fpos);
  231.     if ioresult<>0 then
  232.       Rerror:=true
  233.     else
  234.     begin
  235.       Blockread(Ifile,frec,1,numread);
  236.       if (numread<>1) or (ioresult<>0) then
  237.         Rerror:=true
  238.       else
  239.         Current:=fpos;
  240.     end;
  241.   end;
  242. End;
  243.  
  244. { Writes a record to the file at location Fpos.}
  245. Procedure TFreadObj.WriteRec(var frec; fpos:longint);
  246. Var
  247.   numwritten : word;
  248.   i:integer;
  249. Begin
  250.   Werror:=false;
  251.   if not Oerror then
  252.   begin
  253.     Seek(Ifile,fpos);
  254.     if Ioresult<>0 then
  255.       Werror:=true
  256.     else
  257.     begin
  258.       Blockwrite(Ifile,frec,1,numwritten);
  259.       if (numwritten<>1) or (ioresult<>0) then
  260.         Werror:=true
  261.       else
  262.         Current:=fpos;
  263.     end;
  264.   end;
  265. End;
  266.  
  267. { Appends a record to the end of the file.}
  268. Procedure TFreadObj.AppendRec(var frec);
  269. Begin
  270.   WriteRec(frec,NumRecs);
  271. End;
  272.  
  273. { Reads the next record from the file, allowing sequential access.}
  274. Procedure TFreadObj.ReadNext(var frec);
  275. Begin
  276.   ReadRec(frec,Current+1);
  277. End;
  278.  
  279. { Reads the previous record from the file. }
  280. Procedure TFreadObj.ReadPrevious(var frec);
  281. Begin
  282.   ReadRec(frec,Current-1);
  283. End;
  284.  
  285. { Reads the record pointed to by current. }
  286. Procedure TFreadObj.ReadCurrent(var frec);
  287. Begin
  288.   ReadRec(frec,Current);
  289. End;
  290.  
  291. { Returns the number of records in the file.}
  292. Function TFreadObj.NumRecs:Longint;
  293. Begin
  294.   if not Oerror then
  295.     NumRecs:=Filesize(Ifile);
  296. End;
  297.  
  298. { Returns the file name of the file.}
  299. Function TFreadObj.GetFilename : String;
  300. Begin
  301.   GetFilename:=FileName;
  302. End;
  303.  
  304. { Returns the number of the current record. }
  305. Function TFreadObj.GetCurrent : Longint;
  306. Begin
  307.   GetCurrent:=Current;
  308. End;
  309.  
  310. { No initialization required.}
  311. end.